home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MySounds.p < prev    next >
Encoding:
Text File  |  1993-02-16  |  2.8 KB  |  133 lines  |  [TEXT/PJMM]
  1. unit MySounds;
  2.  
  3. interface
  4.  
  5.     procedure InitSounds;
  6. { Call at start of app }
  7.     procedure IdleSounds;
  8. { Call regularly to release channels after sounds have finished }
  9. { Usually called from the event loop }
  10.     procedure FinishSounds;
  11. { Call at termination of app }
  12.     procedure PlaySounds (theSound: handle);
  13. { Play a sound from a handle }
  14.     procedure PlaySoundsID (id: integer);
  15. { Play a sounds from a "snd " resource }
  16.  
  17. implementation
  18.  
  19.     uses
  20.         Sound;
  21.  
  22.     const
  23.         max_sounds = 10; { Excessive? }
  24.  
  25.     type
  26.         soundRecordState = (SR_Unused, SR_Inuse, SR_Finished);
  27.         mySoundRecord = record
  28.                 state: soundRecordState;
  29.                 sound_chan: SndChannelPtr;
  30.             end;
  31.  
  32.     var
  33.         sounds: array[1..max_sounds] of mySoundRecord;
  34.  
  35.     procedure InitSounds;
  36.         var
  37.             i: integer;
  38.     begin
  39.         for i := 1 to max_sounds do begin
  40.             sounds[i].state := SR_Unused;
  41.             sounds[i].sound_chan := SndChannelPtr(Newptr(SizeOf(SndChannel)));
  42.         end;
  43.     end;
  44.  
  45.     procedure IdleSounds;
  46.         var
  47.             oe: OSErr;
  48.             i: integer;
  49.     begin
  50.         for i := 1 to max_sounds do begin
  51.             if sounds[i].state = SR_Finished then begin
  52.                 oe := SndDisposeChannel(sounds[i].sound_chan, false);
  53.                 sounds[i].state := SR_Unused;
  54.             end;
  55.         end;
  56.     end;
  57.  
  58.     procedure FinishSounds;
  59.         var
  60.             i: integer;
  61.             finished: boolean;
  62.     begin
  63.         finished := false;
  64.         while not finished do begin
  65.             IdleSounds;
  66.             finished := true;
  67.             for i := 1 to max_sounds do begin
  68.                 if sounds[i].state <> SR_Unused then
  69.                     finished := false;
  70.             end;
  71.         end;
  72.     end;
  73.  
  74. {$PUSH}
  75. {$D-}
  76. { Called at interupt level! }
  77.     procedure ChanCallBack (chan: SndChannelPtr; cmd: SndCommand);
  78.         var
  79.             p: ^soundRecordState;
  80.     begin
  81.         p := POINTER(cmd.param2);
  82.         p^ := SR_Finished;
  83.     end;
  84. {$POP}
  85.  
  86.     procedure PlaySounds (theSound: handle);
  87.         var
  88.             oe: OSErr;
  89.             myWish: SndCommand;
  90.             i: integer;
  91.     begin
  92.         if (theSound <> nil) & (theSound^ <> nil) then begin
  93.             IdleSounds;
  94.             i := 1;
  95.             while (i <= max_sounds) & (sounds[i].state <> SR_Unused) do begin
  96.                 i := i + 1;
  97.             end;
  98.             if i <= max_sounds then begin
  99.                 sounds[i].sound_chan^.qLength := stdQLength;
  100.                 oe := SndNewChannel(sounds[i].sound_chan, 0, 0, @ChanCallBack);
  101.                 if oe = noErr then begin
  102.                     MoveHHi(theSound);
  103.                     HLock(theSound);
  104.                     oe := SndPlay(sounds[i].sound_chan, theSound, true);
  105.  
  106.                     if oe = noErr then begin
  107.                         with myWish do begin { set up a sound mgr command block }
  108.                             cmd := callBackCmd;  { set playing to false }
  109.                             param1 := 0;
  110.                             param2 := ord(@sounds[i].state);
  111.                         end; {with}
  112.                         oe := SndDoCommand(sounds[i].sound_chan, myWish, false);
  113.                     end;
  114.                     if oe = noErr then begin
  115.                         sounds[i].state := SR_Inuse;
  116.                     end
  117.                     else begin
  118.                         oe := SndDisposeChannel(sounds[i].sound_chan, false);
  119.                     end;
  120.                 end;
  121.             end;
  122.         end;
  123.     end;
  124.  
  125.     procedure PlaySoundsID (id: integer);
  126.         var
  127.             theSound: handle;
  128.     begin
  129.         theSound := GetResource('snd ', id);
  130.         PlaySounds(theSound);
  131.     end;
  132.  
  133. end.